{*
  Object Pascal simple processor information manipulation routines
  @Author  Maciej Zagozda (1998-2008)
  @Licence Microsoft Reciprocal License (Ms-RL)
  @Website http://www.codeplex.com/intelitechdelphirtns/
  @Version 2008/04/20 Added documentation support
}


unit ProcessorRoutines;

interface

uses
  Classes,
  Contnrs,
  Dialogs,
  Messages,
  Registry,
  SysUtils,
  Windows;

type

  // processor core information object

  TProcessorInformation = class
  private
    fNumber: Byte;
    procedure SetNumber( Value: Byte );
    function GetName: AnsiString;
    function GetNameString: AnsiString;
    function GetSpeed: SmallInt;
    function GetVendor: AnsiString;
    function GetMathEnhanced: Boolean;
    function GetMMXEnhanced: Boolean;
  public
    property Number: Byte read fNumber write SetNumber;
    property Name: AnsiString read GetName;
    property NameString: AnsiString read GetNameString;
    property Speed: SmallInt read GetSpeed;
    property Vendor: AnsiString read GetVendor;
    property MathEnhanced: Boolean read GetMathEnhanced;
    property MMXEnhanced: Boolean read GetMMXEnhanced;
  end;

  // processor cores information object

  TProcessorsInformation = class(TObjectList)
  private
    fCoreCount: Byte;
    function GetProcessor(intIndex: Byte): TProcessorInformation;
    procedure SetProcessor(intIndex: Byte; const objProcessor: TProcessorInformation);
  public
    constructor Create;
    destructor Destroy; override;

    function Add(objProcessor: TProcessorInformation): Integer;
    function IndexOf(objProcessor: TProcessorInformation): Integer;
    procedure Insert(intIndex: Integer; objProcessor: TProcessorInformation);
    function Remove(objProcessor: TProcessorInformation);
    procedure SetItem(intIndex: Integer; objProcessor: TProcessorInformation);

    property CoreCount: Byte read fCoreCount;
    property Cores[intIndex: Byte]: TProcessorInformation read GetProcessor write SetProcessor; default;
  end;

const
  IntelProcessor386 = 386;
  IntelProcessor486 = 486;

// get number of processors
function GetProcessorCount: Byte;
// get processor tech name (like: x86 Family 15 Model 104 Stepping 2)
function GetProcessorName( const intUnitIndex: Byte = 0): AnsiString;
// get processor full name (like: AMD Turion(tm) 64 X2 Mobile Technology TL-60)
function GetProcessorNameString( const intUnitIndex: Byte = 0): AnsiString;
// get processor approximate speed (in Megaherz)
function GetProcessorSpeed( const intUnitIndex: Byte = 0): SmallInt;
// get processor vendor name (like: AuthenticAMD)
function GetProcessorVendor( const intUnitIndex: Byte = 0): AnsiString;
// checks if processor supports mathematical cooprocesor processing
function GetProcessorMathEnhanced( const intUnitIndex: Byte = 0): Boolean;
// checks if processor supports multimedia extensions processing
function GetProcessorMMXEnhanced( const intUnitIndex: Byte = 0): Boolean;

implementation

//_____________________________________________________________________________

function GetProcessorCount: Byte;
const
  strnKey = 'Hardware\Description\System\CentralProcessor\%d\';
var
  Registry: TRegistry;
  intCount: Byte;
  intIndex: Byte;
  blnExists: Boolean;
begin
  intCount := 0;
  intIndex := 0;
  blnExists := True;

  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_LOCAL_MACHINE;

    while blnExists do
    begin
      blnExists := Registry.OpenKeyReadOnly(Format(strnKey,[intIndex]));
      intIndex := intIndex + 1;
      if blnExists then intCount := intIndex +1;
    end;//while
  finally
    Registry.Free;
  end;

  Result := intCount;

end;

//_____________________________________________________________________________

function GetProcessorName( const intUnitIndex: Byte = 0): AnsiString;
const
  strnKey = 'Hardware\Description\System\CentralProcessor\%d\';
  strnValue = 'Identifier';
var
  Registry: TRegistry;
begin
  Result := '';

  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly( Format( strnKey, [intUnitIndex] )) then
      begin
        if ValueExists( strnValue ) then
        begin
          Result := ReadString( strnValue );
        end
        else
        begin
          Result := '';
        end;//if
      end
      else
      begin
        Result := '';
      end;//if
    end;//with
  finally
    Registry.Free;
  end;//try
end;

//_____________________________________________________________________________

function GetProcessorNameString( const intUnitIndex: Byte = 0): AnsiString;
const
  strnKey = 'Hardware\Description\System\CentralProcessor\%d\';
  strnValue = 'ProcessorNameString';
var
  Registry: TRegistry;
begin
  Result := '';

  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly( Format( strnKey, [intUnitIndex] )) then
      begin
        if ValueExists( strnValue ) then
        begin
          Result := ReadString( strnValue );
        end
        else
        begin
          Result := '';
        end;//if
      end
      else
      begin
        Result := '';
      end;//if
    end;//with
  finally
    Registry.Free;
  end;//try
end;

//_____________________________________________________________________________

function GetProcessorSpeed( const intUnitIndex: Byte = 0): SmallInt;
const
  strnKey = 'Hardware\Description\System\CentralProcessor\%d\';
  strnValue = '~MHz';
var
  Registry: TRegistry;
begin
  Result := 0;

  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly( Format( strnKey, [intUnitIndex] )) then
      begin
        if ValueExists( strnValue ) then
        begin
          Result := ReadInteger( strnValue );
        end
        else
        begin
          Result := 0;
        end;//if
      end
      else
      begin
        Result := 0;
      end;//if
    end;//with
  finally
    Registry.Free;
  end;//try
end;

//_____________________________________________________________________________

function GetProcessorVendor( const intUnitIndex: Byte = 0): AnsiString;
const
  strnKey = 'Hardware\Description\System\CentralProcessor\%d\';
  strnValue = 'VendorIdentifier';
var
  Registry: TRegistry;
begin
  Result := '';

  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly( Format( strnKey, [intUnitIndex] )) then
      begin
        if ValueExists( strnValue ) then
        begin
          Result := ReadString( strnValue );
        end
        else
        begin
          Result := '';
        end;//if
      end
      else
      begin
        Result := '';
      end;//if
    end;//with
  finally
    Registry.Free;
  end;//try
end;

//_____________________________________________________________________________

function GetProcessorMathEnhanced( const intUnitIndex: Byte = 0): Boolean;
const
  strnKey = 'Hardware\Description\System\FloatingPointProcessor\%d\';
var
  Registry: TRegistry;
begin
  Result := False;

  Registry := TRegistry.Create;
  try
    with Registry do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly( Format( strnKey, [intUnitIndex] )) then
      begin
        Result := True
      end
      else
      begin
        Result := False;
      end;//if
    end;//with
  finally
    Registry.Free;
  end;//try
end;

//_____________________________________________________________________________

function GetProcessorMMXEnhanced( const intUnitIndex: Byte = 0): Boolean;
var
  sysiSystemInfo: TSystemInfo;
  boolResult: Boolean;
  intgA: Integer;
begin
  boolResult := False;
  GetSystemInfo( sysiSystemInfo );

  if ( sysiSystemInfo.dwProcessorType <= IntelProcessor486) then
  begin
    boolResult := False;
  end
  else
  begin
    asm
      mov  eax, 1
      db   $0F, $A2
      mov  intgA, edx
      test edx, $00800000
      jz   @@notfound
      mov  boolResult, True
    @@notfound:
    end;//asm
  end;//if

  Result := boolResult;
end;

procedure TProcessorInformation.SetNumber( Value: Byte );
begin
  Self.fNumber := Value;
end;


function TProcessorInformation.GetName: AnsiString;
begin
  Result := GetProcessorName(Self.fNumber);
end;

function TProcessorInformation.GetNameString: AnsiString;
begin
  Result := GetProcessorNameString(Self.fNumber);
end;

function TProcessorInformation.GetSpeed: SmallInt;
begin
  Result := GetProcessorSpeed(Self.fNumber);
end;

function TProcessorInformation.GetVendor: AnsiString;
begin
  Result := GetProcessorVendor(Self.fNumber);
end;

function TProcessorInformation.GetMathEnhanced: Boolean;
begin
  Result := GetProcessorMathEnhanced(Self.fNumber);
end;

function TProcessorInformation.GetMMXEnhanced: Boolean;
begin
  Result := GetProcessorMMXEnhanced(Self.fNumber);
end;

constructor TProcessorsInformation.Create;
var
  intA: Byte;
begin
  inherited;
  fCoreCount := GetProcessorCount;

  for intA := 0 to Pred( fCoreCount ) do
  begin
    Add(TProcessorInformation.Create);
    TProcessorInformation(Self[intA]).Number := intA;
  end;
end;

destructor TProcessorsInformation.Destroy;
begin
  inherited;
end;

function TProcessorsInformation.Add(objProcessor: TProcessorInformation): Byte;
begin
  Result := inherited Add( objProcessor );
end;

function TProcessorsInformation.IndexOf(objProcessor: TProcessorInformation): Integer;
begin
  Result := inherited IndexOf(objProcessor);
end;

procedure TProcessorsInformation.Insert(intIndex: Integer; objProcessor: TProcessorInformation);
begin
  inherited Insert(intIndex, objProcessor);
end;

function TProcessorsInformation.Remove(objProcessor: TProcessorInformation);
begin
  Result := inherited Remove(objProcessor);
end;

procedure TProcessorsInformation.SetItem(intIndex: Integer; objProcessor: TProcessorInformation);
begin
  inherited SetItem(intIndex, objProcessor);
end;

function TProcessorsInformation.GetProcessor(intIndex: Byte): TProcessorInformation;
begin
  Result := Get(intIndex);
end;

procedure TProcessorsInformation.SetProcessor(intIndex: Byte; const objProcessor: TProcessorInformation);
begin
  Put(intIndex, objProcessor);

end;

end.
